home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / M2PROTOS.ZIP / QCXMZERO.MOD < prev    next >
Encoding:
Modula Implementation  |  1991-06-11  |  7.6 KB  |  274 lines
  1. (*# call(o_a_copy => off) *)
  2. (*%T _fcall *)
  3. (*# call(seg_name => QCxm) *)
  4. (*%E *)
  5. (*%F _fcall *)
  6. (*# call(seg_name => null) *)
  7. (*%E *)
  8. (*# module(implementation=>on) *)
  9. (*# data(seg_name => null) *)
  10. IMPLEMENTATION MODULE QCxmzero;
  11.  
  12.                      (* This JPI Modula-2 module is part of *)
  13.  
  14.                       (* QC -- a communications program *)
  15.                              (* by Carl Neiburger *)
  16.                               (* 169 N. 25th St.*)
  17.                           (* San Jose, Calif. 95116 *)
  18.  
  19.                          (* CompuServe No. 72336,2257 *)
  20.  
  21. FROM Str IMPORT Append, CHARSET, Delete, Insert, Length, 
  22.     Pos, StrToCard, CardToStr, StrToCard;
  23. FROM FioAsm IMPORT DirEntry, TimeType, DecodeFileTime, EncodeFileTime;
  24. FROM Lib IMPORT Fill, Move;
  25. FROM QCcomm IMPORT ProgramName, soh, syn;
  26. IMPORT NFIO;
  27. FROM UTIL IMPORT str12, str80;
  28.  
  29. TYPE
  30.     BoolLongcardArray = ARRAY BOOLEAN OF LONGCARD;
  31.     Longcard12Array = ARRAY [1..12] OF LONGCARD;
  32.     BoolLongcard12Array = ARRAY BOOLEAN OF Longcard12Array;
  33.  
  34. (*   Ymodem
  35.          FileName       : ASCIIZ
  36.          FileLength     : Decimal ASCII terminated by space
  37.          FileTime       : Octal ASCII+ space, seconds since 1-1-70 GMT
  38.  
  39.  
  40.      TimeType = RECORD in FioAsm
  41.          Year, Month, Day, Hours, Mins, Secs: CARDINAL *)
  42.  
  43. CONST
  44.     SecondsPerYear = BoolLongcardArray (31536000, 31622400);
  45.     SecondsPerDay = 86400;
  46.     SecondsPerHour = 3600;
  47.     SecondsPerMinute = 60;
  48.     M31 = 31*SecondsPerDay;
  49.     M30 = 30*SecondsPerDay;
  50.  
  51.     NormSecondsPerMonth = Longcard12Array 
  52.             (Longcard12Array(M31, 28*SecondsPerDay,
  53.                              M31, M30, M31, M30, M31, M31,
  54.                              M30, M31, M30, M31));
  55.  
  56.     SmallBlockSize = 133;
  57.     LargeBlockSize = 1029;
  58.  
  59.     OKattr = NFIO.FileAttr{NFIO.readonly,NFIO.archive};
  60.  
  61. VAR  
  62.     SecondsPerMonth : Longcard12Array;
  63.  
  64. PROCEDURE BasicBlock(VAR b: BPtr);
  65. BEGIN
  66.   Fill( b, SmallBlockSize, 0);
  67.   b^[1] := soh;
  68.   b^[3] := 255; (* [2] set to zero by Fill *)
  69. END BasicBlock;
  70.  
  71. PROCEDURE LeapYear(y: CARDINAL): BOOLEAN;
  72. BEGIN
  73.     RETURN y MOD 4 = 0
  74. END LeapYear;
  75.  
  76. PROCEDURE February(y : CARDINAL);
  77. BEGIN
  78.     IF LeapYear(y) THEN
  79.          SecondsPerMonth[2] := 29*SecondsPerDay
  80.     ELSE
  81.          SecondsPerMonth[2] := 28*SecondsPerDay
  82.     END
  83. END February;
  84.  
  85. PROCEDURE SecondsToDate(s: LONGCARD; base: CARDINAL): LONGCARD;
  86. VAR d: TimeType;
  87. BEGIN
  88.     Fill( ADR(d), SIZE(d), 0);
  89.     d.Year := base;
  90.     WHILE s > SecondsPerYear[LeapYear(d.Year)] DO
  91.          DEC(s, SecondsPerYear[LeapYear(d.Year)]);
  92.          INC(d.Year);
  93.     END;
  94.     d.Month := 1;
  95.     February(d.Year);
  96.     WHILE (s>SecondsPerMonth[d.Month]) DO 
  97.          DEC(s, SecondsPerMonth[d.Month]);
  98.          INC(d.Month)
  99.     END;
  100.     d.Day := VAL(CARDINAL, s DIV SecondsPerDay) + 1;
  101.     s := s MOD SecondsPerDay;
  102.     d.Hours := VAL(CARDINAL, s DIV SecondsPerHour);
  103.     s := s MOD SecondsPerHour;
  104.     d.Mins := VAL(CARDINAL, s DIV SecondsPerMinute);
  105.     d.Secs := VAL(CARDINAL, s MOD SecondsPerMinute);
  106.     RETURN EncodeFileTime(d)
  107. END SecondsToDate;
  108.  
  109. PROCEDURE DateToSeconds(s: LONGCARD; base: CARDINAL): LONGCARD;
  110. VAR n: CARDINAL; d: TimeType;
  111. BEGIN
  112.     DecodeFileTime(s, d);
  113.     s := 0;
  114.     FOR n := base TO d.Year - 1 DO 
  115.          INC(s, SecondsPerYear[LeapYear(n)])
  116.     END;
  117.     February(d.Year);
  118.     FOR n := 1 TO d.Month - 1 DO
  119.          INC(s, SecondsPerMonth[n])
  120.     END;
  121.     INC(s, VAL(LONGCARD, d.Day - 1) * SecondsPerDay);
  122.     INC(s, VAL(LONGCARD, d.Hours) * SecondsPerHour);
  123.     INC(s, VAL(LONGCARD, d.Mins) * SecondsPerMinute);
  124.     INC(s, VAL(LONGCARD, d.Secs) );
  125.     RETURN s
  126. END DateToSeconds;
  127.  
  128. PROCEDURE CreateYZModemBlock(fname: ARRAY OF CHAR; 
  129.                 VAR tname: PathTail; VAR b: BPtr; Z: CARDINAL): CARDINAL;
  130. VAR DE : DirEntry; i, len: CARDINAL; s: str12; l : LONGCARD; valid : BOOLEAN;
  131. BEGIN
  132.   tname[0] := 0C;
  133.   BasicBlock(b);
  134.   IF NOT NFIO.ReadFirstEntry(fname, OKattr, DE) THEN 
  135.     RETURN 0
  136.   END;
  137.   FOR i := 0 TO Length(DE.Name)-1 DO 
  138.     IF DE.Name[i] IN CHARSET {'A'..'Z'} THEN
  139.          INC(DE.Name[i],32); (* change to lower case *)
  140.     END
  141.   END;
  142.   Move( ADR(DE.Name), ADR(b^[Z]), i+1);
  143.   INC(i,Z+2); (* start of block, and leave a nul *);
  144.   CardToStr( VAL(LONGCARD, DE.size), s, 10, valid);
  145.   Append(s, ' ');
  146.   len := Length(s);
  147.   Move( ADR(s), ADR(b^[i]), len);
  148.   INC(i, len);
  149.   l := DateToSeconds( VAL(LONGCARD, DE.date)<<16
  150.                     + VAL(LONGCARD, DE.time), 1970);
  151.   CardToStr( l, s, 8, valid );
  152.   Append(s, ' ');
  153.   len := Length(s);
  154.   Move( ADR(s), ADR(b^[i]), len);
  155.   RETURN i + len + 1
  156. END CreateYZModemBlock;
  157.  
  158. PROCEDURE CreateYModemBlock(fname: ARRAY OF CHAR; 
  159.                         VAR tname: PathTail; VAR b: BPtr): CARDINAL;
  160. BEGIN
  161.     RETURN CreateYZModemBlock(fname, tname, b, 4 )
  162. END CreateYModemBlock;
  163.  
  164. PROCEDURE CreateZModemBlock(fname: ARRAY OF CHAR; 
  165.                         VAR tname: PathTail; VAR b: BPtr ): CARDINAL;
  166. BEGIN
  167.     RETURN CreateYZModemBlock(fname, tname, b, 1)
  168. END CreateZModemBlock;
  169.  
  170.  
  171. PROCEDURE CreateTelinkBlock(fname: ARRAY OF CHAR; 
  172.                         VAR tname: PathTail; VAR b: BPtr): CARDINAL;
  173. VAR DE : DirEntry; i: CARDINAL;
  174. BEGIN
  175.   BasicBlock(b);
  176.   b^[1] := syn;
  177.   IF NOT NFIO.ReadFirstEntry(fname, OKattr, DE) THEN 
  178.     tname := '           ';
  179.     RETURN 0
  180.   END;
  181.   Move( ADR(DE.size), ADR(b^[4]), 4 );
  182.   Move( ADR(DE.time), ADR(b^[8]), 4 );
  183.   Move( ADR(DE.Name), ADR(b^[12]), Length(DE.Name));
  184.   Move( ADR(ProgramName), ADR(b^[29]), 2);
  185.   tname := DE.Name;
  186.   i := Pos(tname, '.');
  187.   IF i < MAX(CARDINAL) THEN
  188.     Delete(tname, i, 1);
  189.   ELSE
  190.     i := Length(tname);
  191.   END;
  192.   WHILE Length(tname) < 11 DO
  193.     Insert(tname, ' ', i)
  194.   END;
  195.   RETURN 128
  196. END CreateTelinkBlock;
  197.  
  198. PROCEDURE InterpretYModemBlock(b: BPtr; VAR t: TelinkBlockType);
  199. VAR i, p: CARDINAL; s: str80; OK: BOOLEAN; 
  200.  
  201. PROCEDURE ReturnString(): str80;
  202. TYPE SPtr = POINTER TO str80;
  203. VAR sp : SPtr; 
  204. BEGIN
  205.     sp := ADR(b^[i]);
  206.     INC(i, Length(sp^) + 1);
  207.     RETURN sp^
  208. END ReturnString;
  209.  
  210. PROCEDURE DefineNumStr(CS: CHARSET);
  211. (*
  212. PROCEDURE DefineNumStr(Hi: CHAR);
  213. *)
  214. BEGIN
  215.     p := i;
  216. (*
  217.     WHILE CHR(b^[p]) IN CHARSET{'0'..Hi} DO 
  218. *)
  219.     WHILE CHR(b^[p]) IN CS DO 
  220.          INC(p)
  221.     END;
  222.     b^[p] := 0
  223. END DefineNumStr;
  224.  
  225. BEGIN
  226.     i := 1;
  227.     Fill( ADR(t), SIZE(t), 0);
  228.     s := ReturnString();
  229.     REPEAT
  230.          p := Pos(s, '/');
  231.          IF p < MAX( CARDINAL) THEN 
  232.             Delete(s, 0, p+1)
  233.          END
  234.     UNTIL p = MAX( CARDINAL);
  235.     REPEAT
  236.          p := Pos(s, '\');
  237.          IF p < MAX( CARDINAL) THEN 
  238.             Delete(s, 0, p+1)
  239.          END
  240.     UNTIL p = MAX( CARDINAL);
  241.     Move( ADR(s), ADR(t.FileName), Length(s));
  242. (*
  243.     DefineNumStr('9');
  244. *)
  245.     DefineNumStr(CHARSET{'0'..'9'});
  246.     t.FileLength := StrToCard( ReturnString(), 10, OK );
  247.     IF NOT OK THEN 
  248.          t.FileLength := 0
  249.     END;
  250. (*
  251.     DefineNumStr('7');
  252. *)
  253.     DefineNumStr(CHARSET{'0'..'7'});
  254.     t.FileTime := SecondsToDate(StrToCard(ReturnString(), 8, OK), 1970);
  255.     IF NOT OK THEN 
  256.          t.FileTime := 0
  257.     END;
  258. END InterpretYModemBlock;
  259.  
  260. PROCEDURE InterpretTelinkBlock (b: BPtr; VAR t: TelinkBlockType);
  261. BEGIN
  262.     Move( b, ADR(t), SIZE(t))
  263. END InterpretTelinkBlock;
  264.  
  265. BEGIN
  266.     SecondsPerMonth := NormSecondsPerMonth;
  267.     CreateBlock[YModem] := CreateYModemBlock;
  268.     CreateBlock[ZModem] := CreateZModemBlock;
  269.     CreateBlock[Telink] := CreateTelinkBlock;
  270.     InterpretBlock[YModem] := InterpretYModemBlock;
  271.     InterpretBlock[ZModem] := InterpretYModemBlock;
  272.     InterpretBlock[Telink] := InterpretTelinkBlock;
  273. END QCxmzero.
  274.